perm filename JUSTFY.F4[NEW,LCS]15 blob sn#502572 filedate 1980-04-20 generic text, type T, neo UTF8
00100	C*************** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
00200		SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
00300		COMMON /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
00400		DIMENSION IR(2,250),R(2,250),RN(1),NO(1),NP(1),RSTFAC(0/1)
00500		DATA RBX/6.0/,RBZ/8.0/,SPFAC/0.20/
00600		DO 11 KN=0,JLP
00700		RSPC=0
00800		R8=KN
00900		N=0
01000	
01100		DO 2 K=1,KY
01200		L=NP(K)
01300		RL=RN(L)
01400	C  RL=WDCNT-2
01500		RA=RN(L+1)
01600	C  RA=CODE NUM.
01700		RB=RN(L+3)
01800	C  RB=POSITION(P3)
01900		IF(RN(L+2).EQ.R8)GO TO 77
02000	C  THIS STAFF?
02100		IF(RA.NE.4)GO TO 2
02200	C  SKIPS HOMED NOTES (IN CHORDS)
02300	77	IF(RA.LT.3)GO TO 20
02400		IF(RA.EQ.4)GO TO 444
02500		IF(RA.EQ.3)GO TO 333
02600	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
02700	C***	CAN'T WORK YET ***** IF(RA.LT.16)GO TO 2
02800		IF(RA.LT.17)GO TO 2
02900		GO TO 10
03000	333	IF(RL.LT.3)GO TO 10
03100	C  <3 MEANS NOTHING IN P5
03200		IF(RN(L+5).GT.4)GO TO 2
03300	C  NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
03400		GO TO 10
03500	444	IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 2
03600	C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
03700	CC  FOR REPEAT BAR WDCNT IS 3 -- 10/77 444	IF(RL.GT.2)GO TO 2
03800	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
03900		GO TO 10
04000	20	IF(RA.NE.2)GO TO 113
04100	C ASSUMES WD CNT. IS GREAT ENOUGH!?!?!?!?
04200		IF(RN(L+6))GO TO 2
04300		IF(RN(L+7))GO TO 2
04400	C SKIP INVIS. RESTS AND RESTS WITH NEG. RHYTH. (PUT THIS IN OTHER JUST. PROGS.)
04500		GO TO 10
04600	113	IF(RL.LT.7)GO TO 10
04700	C NOW NOTES.  SKIP IF NEG. VALUE IN P9 (IT'S A SUPPLEMENTAL NOTE.)
04800		IF(RN(L+9).LT.0)GO TO 2
04900	10	N=N+1
05000		R(1,N)=RB
05100		IR(2,N)=L
05200		IF(N.EQ.250)GO TO 28
05300	C  ONLY TREATS 250 ITEMS AT A TIME.
05400	2	CONTINUE
05500	
05600		IF(N.EQ.0)GO TO 11
05700	28	DO 23 K=1,N
05800	23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
05900	C  SKIPS IF ONLY BAR LINES ON THIS STAFF
06000		GO TO 11
06100	24	RSZ=RSTFAC(KN)*PRCNT
06200		CALL SORT2(R,N)
06300	
06400	C  JUMP IF LAST IS A BAR LINE.
06500		K=0
06600		JLDGR=0
06700	     	JX=0
06800	22	K=K+1
06900	122	L=IR(2,K)
07000		RA=RN(L+1)
07100	C  RA IS NOW CODE NUM.
07200		RL=RN(L)
07300	C  RL=WDCNT-2
07400		RB=0
07500		RD=0
07600	C  RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
07700		RX=RN(L+5)
07800	C  RX=PARAM 5
07900		RX6=RN(L+6)
08000		RY=1
08100		RW=AMOD(RN(L+4),100.)
08200		RSP=SPFAC*RSTFAC(IFIX(RN(L+2)))
08300		IF(RA.GT.1)GO TO 4
08400		RZ=RN(L+7)
08500		IF(LDGR.NE.JLDGR)JLDGR=0
08600	C CHECK FOR PRESENCE OF LEDGER LINES WITH SUCCESSIVE NOTES
08700		LDGR=0
08800		JK=K
08900		DO 32 JJ=JK+1,N+1
09000		K=JJ
09100		RB=R(1,JJ)-R(1,JJ-1)
09200		IF(RB.GT.0.1)GO TO 320
09300	C  PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
09400		R(1,JJ)=R(1,JJ-1)
09500		GO TO 32
09600	320	IF(RB.GT.RSP)GO TO 35
09700	32	CONTINUE
09800	C  FOUND HOW MANY MEMBERS TO CHORD.
09900	35	RB=0
10000		K=K-1
10100		RQ=0
10200	125	RC=ABS(RN(L+4))
10300		
10400		IF(RC.LT.60)GO TO 637
10500		IF(RC.LT.180)RY=.6
10600	C  FOUND A MINI-NOTE
10700	
10800	637	RSDF=0
10900		IF(RA.EQ.1)GO TO 437
11000	C JUMP IF NOTE
11100		RDF=-1
11200	C NOW IT'S ANYTHING BUT A NOTE
11300		GO TO 137
11400	437	IF(RL.LT.8)GO TO 237
11500	C JUMP IF THERE IS NOT P10 TO LOOK AT
11600		RW=RN(L+10)
11700	C PUT P10 INTO RW
11800		GO TO 337
11900	237	RW=0
12000	337	IF(RDF.LT.0)GO TO 537
12100	C JUMP IF PREVIOUS WAS NOT A NOTE
12200		IF(RW.EQ.RDF)GO TO 137
12300	C SKIP TO FAR END OF LOOP IF THINGS ARE ON DIFF. STAVES. (CLEFS?, ETC?)
12400		RSDF=-1
12500	537	RDF=RW
12600	C SAVE STAFF INFO FOR NEXT TIME AROUND.
12700	
12800	137	DO 37 JJ=JK,K
12900	C*******	IF(RD.NE.0)GO TO 38
13000	C FINDS ONLY HIGH OR! LOW LED. LINE.
13100		JR=IR(2,JJ)
13200		RW=AMOD(RN(JR+4),100.)
13300		IF(RW.GT.12)GO TO 277
13400		IF(RW.GE.2)GO TO 38
13500	277	LDGR=-1
13600		IF(RW.GT.11)LDGR=1
13700		IF(JLDGR.EQ.LDGR)GO TO 36
13800		JLDGR=LDGR
13900	C LDGR IS FOR LEDGER LINES.
14000		GO TO 38
14100	36	IF(RD.GE.1.5)GO TO 38
14200		RD=1.5
14300		RQ=RD
14400	38	IF(RB.GT.2)GO TO 222
14500	C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
14600		RZZ=RN(JR+7)
14700		RE=RN(JR+5)
14800		IF(RB.GE.2)GO TO 477
14900		RC=1.5
15000		IF(RZZ.LT.10)GO TO 378
15100		IF(RZZ.GE.20)RC=3.
15200	C   10=DOT, 20=DOUBLE DOT
15300		GO TO 377
15400	378	IF(RE.GE.20)GO TO 477
15500		IF(AMOD(RZZ,10.).EQ.0)GO TO 477
15600	377	RB=RC+EXTEN(RZZ)
15700	C  SPACE FOR DOT OR TAIL(IF STEM UP)
15800	477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
15900	C  FOR CHORD TONES ON RIGHT OF STEM UP.
16000	C  LOOKS THROUGH ALL NOTES OF A CHORD.
16100	222	RC=AMOD(RE,10.0)
16200		IF(RC.EQ.0)GO TO 37 
16300	C  JUMP IF NO ACCIS.  NOW SEE IF THERE'S SPACE FOR ACCI.
16400		IF(RN(JIR+1).NE.1)GO TO 425
16500	C*	RX=0
16600	C*	IF(RN(JR).GE.8)RX=RN(JR+10)
16700	C*	RXX=0
16800	C*	IF(RN(JIR).GE.8)RXX=RN(JIR+10)
16900	C*	RDF=0
17000	C*	IF(RX.NE.RXX)RDF=100.
17100	C SAVE INFO ON NOTES ON DIFF. STAVES.
17200	C*	IF(RXX.EQ.1.OR.RX.EQ.2)RDF=-RDF
17300	C**** THIS NEXT AREA PROBABLY NEEDS MORE WORK (2/78) ***********
17400	C JIR IS POINTER TO PREVIOUS ITEM.  SKIP IF NOT A NOTE.
17500		KX=RC
17600	C KX=ACCI ON CURRENT NOTE
17700		RD=1 
17800	C ADD A LITTLE SPACE FOR ACCI. ANYHOW.
17900		RX=RN(L+4)
18000		RXX=ABS(RX)
18100	C THIS NOTE
18200	577	IF(RXX.LT.80)GO TO 677
18300	C FIND MINIS, HARMONICS, ETC.
18400		RXX=RXX-100
18500		GO TO 577
18600	677	IF(RX)RXX=-RXX
18700		RX=RXX
18800		RDIF=RN(JIR+4)
18900		RXX=ABS(RDIF)
19000	777	IF(RXX.LT.80)GO TO 877
19100	C FIND MINIS, HARMONICS, ETC.
19200		RXX=RXX-100
19300		GO TO 777
19400	877	IF(RDIF)RXX=-RXX
19500	
19600		RDIF=RX-RXX
19700	C HEIGHT DIFF.  JUMP OUT IF TOO CLOSE TOGETHER. AMOD IS FOR GRACE NOTES, ETC.
19800		RX=3
19900		JSTM=RN(JIR+5)/10.0 
20000	C JSTM=STEM DIRECTION OF PREVIOUS NOTE. 1=UP, 2=DOWN
20100		IF(RDIF.GT.0)GO TO 427
20200	C JUMP IF PREV NOTE IS BELOW. LIMITS: b OR NAT.=3, #=4
20300		IF(JSTM.NE.2)GO TO 424
20400		IF(AMOD(RN(JIR+7),10.0).GE.1)GO TO 425
20500	C JUMP IF PREV. NOTE HAS STEM DOWN WITH TAIL.  THEN WE NEED SPACE.
20600	424	IF(KX.NE.2)RX=5
20700		GO TO 428
20800	427	IF(KX.EQ.2)RX=4
20900	C PREV NOTE IS ABOVE. LIMITS: b OR NAT.=5, #=3
21000	428	IF(ABS(RDIF).LT.RX)GO TO 425
21100		IF(RDIF)GO TO 426 
21200	C JUMP IF THIS NOTE IS LOWER THAN PREV.
21300		IF(JSTM.NE.1)GO TO 426 
21400	C NO  BIG SPACE NEEDED IF PREV. NOTE HAS STEM DOWN AND IS BELOW.
21500	
21600	425	RW=2.8
21700		IF(IFIX(AMOD(RE,10.0)).EQ.4)RW=4.8
21800	CATCHES DOUBLE FLAT (=4)
21900	   	RD=RW*RY+EXTEN(RE)+OTHSID(RN,JR)
22000	CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425	RD=2*RY+EXTEN(RE)
22100	426	IF(RQ.GT.RD)RD=RQ
22200		RQ=RD
22300	C  FUNCT. EXTEN=AMOD(X,1.)*10.
22400	37 	CONTINUE
22500	
22600		IF(RY.NE.1)RB=RB-.5*RJSZ
22700	C  MINI NOTES NEED LESS SPACE
22800	250	IF(RSDF)GO TO 17
22900		ACCX=0
23000	CC	RC=0
23100	 	JIR=JX+2
23200		IF(JIR.GE.N)GO TO 25
23300		RW=R(1,JIR-1)
23400	
23500		DO 132 JJ=JIR,N  
23600		IF(RW.NE.R(1,JJ))GO TO 25
23700		KX=IR(2,JJ)
23800	C  GET POINTER
23900		IF(RN(KX+1).NE.1)GO TO 25
24000	C  ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
24100	CC	RE=ABS(RN(KX+6))
24200	CC	IF(RE.GE.10)RC=-2.6
24300	CC	IF(RE.EQ.20)RC=-RC
24400		RC=OTHSID(RN,KX)
24500		RE=AMOD(RN(KX+5),10.0)
24600	C  FIND AN ACCI
24700		IF(RE.GE.1)RC=RC+2
24800		IF(IFIX(RE).EQ.4)RC=RC+2
24900	C  FOUND AN ACCI    RE=4=DOUBLE FLAT
25000		RC=AMOD(RE,1.0)*10.0+RC
25100	C  ADD ANY EXTENSION TO THE LEFT
25200		IF(RC.GT.ACCX)ACCX=RC
25300	CC	RC=0
25400		IF(ACCX.GT.RD)RD=ACCX
25500	132	CONTINUE
25600		GO TO 25
25700	
25800	4	IF(RA.NE.2)GO TO 33
25900	C  NEXT FOR DOTTED RESTS - IN P6
26000		IF(RL.GE.4)RB=RN(L+6)*1.5
26100	C  NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
26200		GO TO 250
26300	33	IF(RA.NE.3)GO TO 29
26400		RB=3
26500		IF(RN(L+4).GT.80)RB=1.5
26600	C  CHECK ON SIZE NEEDED FOR CLEFS.  >80 = MINICLEF
26700	29	IF(RA.NE.4)GO TO 26
26800	C BAR LINES
26900		IF(RN(L+4).LT.0)GO TO 17
27000	C SKIP IF INVISIBLE BAR LINE (FOR PAGE PROGRAM )
27100		RB=-RJSZ/2
27200		RD=.9
27300		KX=RN(L+4)/1000.
27400		IF(KX.LE.0.)GO TO 25
27500		RD=RD+1.2
27600	C  ADD A LITTLE SPACE IN FRONT OF DBL BAR.
27700		IF(KX.GT.1)GO TO 229
27800		IF(RL.LT.3)GO TO 25
27900	C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN P5.
28000	CCC	IF(KX.EQ.1.OR.KX.EQ.3)RD=RD+RD
28100	229	IF(KX.NE.2)RD=RD+RD
28200	C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
28300	C  REPT BAR WITH DOTS TO LEFT.  ADD SPACE IN FRONT OF IT.
28400		RB=-RB/RBX
28500		IF(KX.EQ.4)KX=0
28600	129	IF(KX.GE.2)RB=RBZ*RB
28700	C  IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
28800		GO TO 25
28900	
29000	26	IF(RA.NE.18)GO TO 30
29100	C METER
29200		RC=0
29300		IF(RL.GE.7)RC=9
29400	C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
29500		RB=-1
29600		RD=1
29700		IF(RX6.LE.9.AND.RX.LE.9)GO TO 31
29800	C  CHECKS FOR 2-DIGIT METERS
29900		RD=2
30000		RB=0
30100	31	RB=RB+RC
30200		GO TO 25
30300	30	IF(RA.NE.17)GO TO 17
30400	C30	IF(RA.NE.16)GO TO 34
30500	C	IF(RL.GE.8.0)GO TO 3 ***THIS NEXT CAN'T WORK YET ****
30600	C P10 MUST =0		*** BECAUSE NO INFO IN P9 WITH SHORT GROUPS ***
30700	C	RC=R(1,N)
30800	C P3 POSITION
30900	C	KY=L
31000	C	RX=0
31100	C	DO 134 KX=1,N
31200	C	L=IR(2,KX)
31300	C	IF(RN(L+1).NE.16.0)GO TO 134
31400	C SKIP IF NEXT IS NOT WORD
31500	C	RW=0
31600	C	IF(RC.LE.RN(L+3))GO TO 134
31700	C SKIP IF WORD IS TO RIGHT OF NEXT WORD
31800	C334	RW=RW+RN(KY+9)
31900	C UPDATE SPACE NEEDED (IN P9)
32000	C	IF(RN(KY+10).NE.16.0)GO TO 234
32100	C JUMP OUT IS NEXT IS NOT WORD
32200	C	KY=KY+9
32300	C	IF(RN(KY).LE.7.0)GO TO 234
32400	C JUMP OUT IF NEXT STARTS NEW GROUP OF CHARS.
32500	C	KY=KY+1
32600	C	GO TO 334
32700	C234	RW=RN(L+3)+RW*RSZ
32800	C NOW RW GIVES END POINT OF GROUP
32900	C	IF(RW.GT.RX)RX=RW
33000	C RX IS POINT FOR COMPARISON (CAN OVERLAP)
33100	C134	CONTINUE
33200	C	IF(RX.EQ.0.OR.RC-RX.GE.RSP)GO TO 3
33300	C GO TO 3 IF ENOUGH SPACE ALREADY
33400	C	GO TO 25
33500	C34	IF(RA.NE.17)GO TO 17
33600	C KSIG  
33700		RX=ABS(RX)
33800		IF(RX.GE.100)RX=RX-100
33900	C  +100 FOR NATURALS AS KEYSIG.
34000		RB=2*(RX-1)-2
34100	C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
34200		RD=2
34300	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSZ
34400	17	RC=(RB+RJSZ)*RSZ
34500	C  RJSZ=DEFAULT SIZE
34600		JIR=L
34700	C SAVE THE POINTER FOR ACCI. CHECK AT 110
34800		JX=K
34900		R(2,JX)=RC
35000	3	IF(K.LT.N)GO TO 22
35100		RA=R(1,1)
35200		RB=R(2,1)
35300	
35400		DO 13 KX=2,JX
35500		RE=R(1,KX)
35600	C  POS. BEFORE SHIFTING
35700		IF(ABS(RE-RA).GT.RSP)GO TO 14
35800	CCC	IF(ABS(RE-RA).GT..5)GO TO 14
35900		IF(R(2,KX).GT.RB)GO TO 16
36000	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
36100		GO TO 13
36200	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
36300	14	RD=RA+RB-RE
36400		IF(RD.LE.0)GO TO 16
36500	C  THERE'S ENOUGH ROOM
36600		ROV=ROV+RD
36700	140	R4=RE+RSPC-.001
36800		R5=10000
36900		R8=RD
37000		R9=0
37100	C  GO EXPAND IT
37200		IF(R(2,KX).EQ.0)GO TO 15
37300		CALL MOVIT(RN,NO,R4,R5,R8,R9)
37400	C????	IF(R2.LE.4)GO TO 15
37500	C SKIP NEXT IF COMING FROM 'PAGE' OR 'JUST'
37600		IF(R2.LE.7)GO TO 15
37700		R5=R4
37800		R4=RA+.001+RSPC
37900		R8=R4
38000		R9=R5+RD-.001
38100	C  FOR ITEMS ON OTHER LINES.
38200		CALL MOVIT(RN,NO,R4,R5,R8,R9)
38300	15	RSPC=RSPC+RD
38400	C  RSPC SAVES TOTAL SPACE ADDED
38500	16	RB=R(2,KX)
38600	13	RA=RE
38700	11	CONTINUE
38800		END
38900	
39000		FUNCTION OTHSID(RN,J)
39100		DIMENSION RN(1)
39200		OTHSID=0
39300		A=ABS(RN(J+6))
39400		IF(A.GE.10)OTHSID=-2.6
39500	C  OTHSID=SPACE NEEDED (+ OR -) BECAUSE OF NOTE ON 'WRONG' SIDE OF STEM.
39600		IF(A.GE.20)OTHSID=-OTHSID
39700		END